Last updated: 2016-07-25

Code version: 8d8a90be8f390aa37396018ea65c39ea07d91061

load("../output/dsc-shrink-files/res.RData")
source("../R/set_plot_colors.R")
library(dplyr)

Attaching package: 'dplyr'
The following objects are masked from 'package:stats':

    filter, lag
The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union
library(ggplot2)

#' @param df dataframe of scores for many methods/scenrios etc
#' @return tall dataframe with columns of scores for each method and the "goldmethod" against which plot is to be made
process_score_for_plotting_against_gold=function(df,PLOTMETHODS=c("ash.n","ash.u","ash.hu"),
                                                 GOLDMETHOD="bayes",PLOTSEEDS=1:100,
                                                 PLOTSCENARIOS=c("spiky","near-normal","flat-top","skew","big-normal","bimodal"),
                                                 PLOTNAMES=PLOTSCENARIOS){
  df %<>% filter(seed %in% PLOTSEEDS) %>% filter(scenario %in% PLOTSCENARIOS) %>% filter(method %in% c(PLOTMETHODS,GOLDMETHOD))
  df$scenario = factor(df$scenario,levels=PLOTSCENARIOS)
  levels(df$scenario)= PLOTNAMES
  #create tall version of dataframe
  df %<>% dplyr::select(-user.self,-sys.self,-elapsed,-user.child,-sys.child) %>%
    reshape2::melt(id.vars=c("method","scenario","seed",".id"),value.name="val")
  #separate bayes and remainder
  df.bayes = df %>% filter(method==GOLDMETHOD)
  df.rest = df %>% filter(method!=GOLDMETHOD)

#join bayes with others, so each line has both the bayes and the non-bayes version
  return(inner_join(df.bayes, df.rest, by=c("scenario","seed","variable")))
}


plot_lfsr=function(lfsr,xlab="True lfsr",ylab="Estimated lfsr",xlim=c(0,0.2),ylim=c(0,0.2),legend.position="bottom"){
  p=ggplot(lfsr,
         aes(val.x,val.y,colour=method.y)) +
    facet_grid(. ~ scenario) + 
    guides(alpha=FALSE) +
    geom_abline(colour = "black") +
    geom_abline(colour= "red", slope=2) +
    xlab(xlab) +
    ylab(ylab) +
    geom_point(shape=1,size=0.1,alpha=0.2) 

  p +scale_y_continuous(limits=ylim) +
        scale_x_continuous(limits=xlim)
         
}

lfsr = process_score_for_plotting_against_gold(res$lfsr,PLOTSEEDS=1:100,PLOTMETHODS="ash.n")
lfdr = process_score_for_plotting_against_gold(res$lfdr,PLOTSEEDS=1:100,PLOTMETHODS="ash.n")

p1=plot_lfsr(lfsr,ylim=c(0,1),xlim=c(0,0.2))
p2=plot_lfsr(lfdr,ylim=c(0,1),xlim=c(0,0.2),xlab="True lfdr",ylab="Estimated lfdr")

# cowplot command: plot_grid(p2+theme_gray()+theme(legend.position="none"),p1+theme_gray()+theme(legend.position="none"),nrow=2,align="v")
print(p1+theme(legend.position="none",axis.text.x = element_text(size = 8,angle=45))
      +coord_equal(ratio=1/5) + colScale)
Warning: Removed 484436 rows containing missing values (geom_point).

#ggsave("../paper/figures/lfsr_est.pdf",height=3,width=9)
print(p2+theme(legend.position="none",axis.text.x = element_text(size = 8,angle=45))
      +coord_equal(ratio=1/5) + colScale)
Warning: Removed 421332 rows containing missing values (geom_point).

#ggsave("../paper/figures/lfdr_est.png",height=3,width=9)
#ggsave("../paper/figures/lfdr_est.pdf",height=3,width=9)
lfsr.s = process_score_for_plotting_against_gold(res$lfsr,PLOTSEEDS=1:100,PLOTMETHODS="ash.n.s")
p1.s=plot_lfsr(lfsr.s,ylim=c(0,1),xlim=c(0,0.2))

print(p1.s+theme(legend.position="none",axis.text.x = element_text(size = 8,angle=45))
      +coord_equal(ratio=1/5))
Warning: Removed 484434 rows containing missing values (geom_point).

#ggsave("../paper/figures/lfsr_est_s.png",height=3,width=9)
#ggsave("../paper/figures/lfsr_est_s.pdf",height=3,width=9)
lfsr.s.nn = process_score_for_plotting_against_gold(
    res$lfsr,PLOTSEEDS=1:100,PLOTMETHODS="ash.n.s",
    PLOTSCENARIOS=paste0(c("spiky","near-normal","flat-top","skew","big-normal","bimodal"),"-nn"))
p1.s.nn=plot_lfsr(lfsr.s.nn,ylim=c(0,1),xlim=c(0,0.2))

print(p1.s.nn+theme(legend.position="none",axis.text.x = element_text(size = 8,angle=45))
      +coord_equal(ratio=1/5))
Warning: Removed 251068 rows containing missing values (geom_point).

#ggsave("../paper/figures/lfsr_est_s_nn.png",height=3,width=9)

Session information

sessionInfo()
R version 3.3.1 (2016-06-21)
Platform: x86_64-apple-darwin13.4.0 (64-bit)
Running under: OS X 10.11.5 (El Capitan)

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] dplyr_0.4.3        ggplot2_2.1.0      RColorBrewer_1.1-2
[4] knitr_1.13        

loaded via a namespace (and not attached):
 [1] Rcpp_0.12.6        magrittr_1.5       munsell_0.4.3     
 [4] colorspace_1.2-6   xtable_1.8-2       R6_2.1.2          
 [7] stringr_1.0.0      plyr_1.8.4         tools_3.3.1       
[10] parallel_3.3.1     grid_3.3.1         gtable_0.2.0      
[13] DBI_0.4-1          dscr_0.1.1         htmltools_0.3.5   
[16] lazyeval_0.2.0     yaml_2.1.13        assertthat_0.1    
[19] digest_0.6.9       shiny_0.13.2       reshape2_1.4.1    
[22] formatR_1.4        evaluate_0.9       mime_0.4          
[25] rmarkdown_0.9.6.14 labeling_0.3       stringi_1.1.1     
[28] scales_0.4.0       httpuv_1.3.3